#!/usr/biin/r

library(XML)

eutils = function(email, baseurl='http://eutils.ncbi.nlm.nih.gov/entrez/eutils', tool='reutils') {

	RETMAX = 10

	join = function(..., operator='&', format='%s=%s', order=1:2) {
    	values = c(...)
    	if (!length(values))
    	    return('')
    	parameters = names(values)
    	paste(collapse=operator, 
    	    mapply(
    	        function(parameter, value) 
    	            if (parameter=='') value 
    	            else do.call(sprintf, c(format, list(parameter, value)[order])),
    	        if (is.null(parameters)) '' else parameters,
    	        values)) }	
    	        
    einfo = function(database=NULL) {
        url = sprintf('%s/einfo.fcgi?%s', baseurl,
            if (is.null(database)) '' else join(db=database))
        response = xmlInternalTreeParse(url)
        if (is.null(database))  
            list(databases=xpathSApply(response, '//DbList/DbName', xmlValue))
        else c(
        	response=response,
            list(
                fields=as.data.frame(stringsAsFactors=FALSE, split(
                    xpathSApply(response, '//FieldList/Field/*', xmlValue),
                    xpathSApply(response, '//FieldList/Field[position()=1]/*', xmlName))),
                links=as.data.frame(stringsAsFactors=FALSE, split(
                    xpathSApply(response, '//LinkList/Link/*', xmlValue),
                    xpathSApply(response, '//LinkList/Link[position()=1]/*', xmlName)))),
            lapply(
                list(id='DbName', name='MenuName', description='Description', count='Count', update='LastUpdate'),
                function(name) 
                    xpathSApply(response, sprintf('/*/*/%s', name), xmlValue))) }
                    
    esearch = function(..., 
            database, history='y', webenv=NULL, key=NULL, 
            field=NULL, reldate=NULL, mindate=NULL, maxdate=NULL, 
            datetype=NULL, retstart=0, retmax=RETMAX, retmode=NULL, rettype=NULL, 
            sort=NULL) {
        query = do.call(join, c(..., list(operator=' AND ', format='%s[%s]', order=2:1)))
        url = sprintf('%s/esearch.fcgi?%s', 
            baseurl,
            do.call(join, as.list(
                c(db=database, term=query, usehistory=history, WebEnv=webenv,
                    query_key=key, tool=tool, email=email, field=field, reldate=reldate,
                    mindate=mindate, maxdate=maxdate, datetype=datetype,
                    retstart=0, retmax=retmax, retmode=retmode, rettype=rettype,
                    sort=sort))))
        response = xmlInternalTreeParse(url)
        c(	url=url,
        	response=response,
            identifiers=xpathSApply(response, '//IdList/Id', xmlValue),
            lapply(
                list(count='Count', retmax='RetMax', retstart='RetStart', key='QueryKey', webenv='WebEnv'),
                function(name)
                    xpathSApply(response, sprintf('/*/%s', name), xmlValue))) }
                    
    epost = function(..., database, retmode=NULL, key=NULL, webenv=NULL) {
        query = do.call(join, c(..., list(operator=',', format='%s', order=1)))
        url = sprintf('%s/epost.fcgi?%s',
            baseurl,
            do.call(join, as.list(
                c(db=database, id=query, retmode=retmode, query_key=key, WebEnv=webenv, tool=tool, email=email))))
        response = xmlInternalTreeParse(url)
        c(	url=url,
        	response=response,
	        lapply(
    	        list(key='QueryKey', webenv='WebEnv'),
    	        function(name)
    	            xpathSApply(response, sprintf('/*/%s', name), xmlValue))) }
                
    esummary = function(..., database, retstart=0, retmax=RETMAX, 
            retmode=NULL, key=NULL, webenv=NULL) {
        query = do.call(join, c(..., list(operator=',', format='%s', order=1)))
        url = sprintf('%s/esummary.fcgi?%s',
            baseurl,
            do.call(join, as.list(
                c(db=database, id=query, retmode=retmode, retstart=0, retmax=retmax, query_key=key, WebEnv=webenv, tool=tool, email=email))))
        response = xmlInternalTreeParse(url)
        parseItems = function(node) c(
        	{	values = xpathApply(node, './Item[@Type!="List" and @Type!="Structure"]', xmlValue)
        		names(values) = xpathApply(node, './Item[@Type!="List" and @Type!="Structure"]/attribute::Name', identity)
        		values },
        	{	values = xpathApply(node, './Item[@Type="List" or @Type="Structure"]', parseItems)
        		names(values) = xpathApply(node, './Item[@Type="List" or @Type="Structure"]/attribute::Name', identity)
        		values })
        items = xpathApply(response, '//DocSum', parseItems)
        names(items) = xpathSApply(response, '//DocSum/Id', xmlValue)
        list(url=url, response=response, items=items) }
        
	efetch = function(database, key, webenv, rettype=NULL, retmode=NULL, retstart=0, retmax=RETMAX) {
        url = sprintf('%s/efetch.fcgi?%s',
            baseurl,
            do.call(join, as.list(c(
            	db=database, query_key=key, WebEnv=webenv, tool=tool, email=email, rettype=rettype,
            	retmode=retmode, retstart=retstart, retmax=retmax))))
        response = xmlInternalTreeParse(url)
        list(url=url, response=response) }	
	
	espell = function() {}
	
	egquery = function() {}
        
    list(einfo=einfo, esearch=esearch, epost=epost, esummary=esummary, efetch=efetch, join=join, baseurl=baseurl, email=email, tool=tool) }
